home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / DIR2ARRY.BAS < prev    next >
BASIC Source File  |  1992-08-10  |  5KB  |  140 lines
  1. 'FULLDIR.BAS by Gaylon Hill
  2. '
  3. 'CALL FullDir(Dir$(), DirNum, FileDir, Path$, WildCard$)
  4. 'Dir$()     - is filled with the directory file names, size, date, & time.
  5. 'Dirnum     - returns the number of Dir$() (arrays).
  6. 'FileDir    - if FileDir = 1 then sub-directories names are returned, also.
  7. 'Path$      - if Path$= "" then the default path is used. Please note,
  8. '             if the Path$ is given then the wildcard will have to be
  9. '             given with the path name.
  10. '             Ex: Path$ = "\MAIN\QB\*.BAS" or Path$ = "A:\*.*"
  11. 'WildCard$  - the WildCard$ selects the type of file needed. Use ? or *
  12. '             to narrow the file selection. If WildCard$ = "" then the
  13. '             default is "*.*". This entry has NO EFFECT when the Path$
  14. '             is given.
  15.  
  16. TYPE FileFindBuf
  17.         DOS            AS STRING * 19
  18.         CreateTime     AS STRING * 1
  19.         Attributes     AS INTEGER
  20.         AccessTime     AS INTEGER
  21.         AccessDate     AS INTEGER
  22.         FileSize       AS LONG
  23.         FileName       AS STRING * 13
  24. END TYPE
  25.  
  26. TYPE Register
  27.         ax    AS INTEGER
  28.         bx    AS INTEGER
  29.         cx    AS INTEGER
  30.         dx    AS INTEGER
  31.         bp    AS INTEGER
  32.         si    AS INTEGER
  33.         di    AS INTEGER
  34.         flags AS INTEGER
  35.         ds    AS INTEGER
  36.         es    AS INTEGER
  37. END TYPE
  38.  
  39. DEFINT A-Z
  40. '
  41. SUB FullDir (Dir$(), DirNum, FileDir, path$, WildCard$)
  42.  
  43.         DIM inreg AS Register, outreg AS Register
  44.         DIM Buffer AS FileFindBuf
  45.  
  46.         DirNum = 0
  47.  
  48.         IF WildCard$ = "" THEN
  49.                 WildCard$ = "*.*"
  50.         END IF
  51.  
  52.         IF path$ = "" THEN
  53. ' Get Current Drive
  54.  
  55.                 inreg.ax = &H1900
  56.                 CALL Interrupt(&H21, inreg, inreg)
  57.                 Drive$ = CHR$(65 + inreg.ax MOD 256)
  58. ' Get Current Path
  59.                 DIM PathSize AS STRING * 64
  60.                 inreg.ax = &H4700
  61.                 inreg.dx = ASC(Drive$) - 64
  62.                 inreg.ds = VARSEG(PathSize)
  63.                 inreg.si = VARPTR(PathSize)
  64.                 CALL InterruptX(&H21, inreg, inreg)
  65.                 path$ = LEFT$(PathSize, INSTR(PathSize, CHR$(0)) - 1)
  66.                 path$ = Drive$ + ":\" + path$ + "\" + WildCard$
  67.         END IF
  68. 'Set the area where the file information will be stored
  69.         inreg.ax = &H1A00
  70.         inreg.ds = VARSEG(Buffer)
  71.         inreg.dx = VARPTR(Buffer)
  72.         CALL Interrupt(&H21, inreg, outreg)
  73. ' Find the first file, if FirstFM=0 then continue.
  74.         inreg.ax = &H4E00
  75.         inreg.cx = 62
  76.         NPath$ = path$ + CHR$(0)
  77.         inreg.dx = SADD(NPath$)
  78.         CALL Interrupt(&H21, inreg, outreg)
  79.         FirstFM = (outreg.ax AND &HF)
  80. 'Find the next file(s), if NextFM<>0 then exit.
  81.         IF FirstFM = 0 THEN
  82.                 GOSUB MakeFile
  83.                 DO
  84.                         inreg.ax = &H4F00
  85.                         inreg.dx = SADD(NPath$)
  86.                         CALL Interrupt(&H21, inreg, outreg)
  87.                         NextFM = outreg.ax AND &HF
  88.                         IF NextFM = 0 THEN
  89.                                 GOSUB MakeFile
  90.                         END IF
  91.                 LOOP WHILE NextFM = 0
  92.         END IF
  93.         EXIT SUB
  94. MakeFile:
  95.         IF LEFT$(Buffer.FileName, 1) = "." THEN
  96.                 RETURN
  97.         END IF
  98.  
  99.         FSize$ = RIGHT$(SPACE$(8) + STR$(Buffer.FileSize), 8)
  100.  
  101.         BitT = Buffer.AccessTime
  102.         ahr = 0
  103.         IF BitT < 0 THEN BitT = 32767 + BitT: ahr = 16
  104.         hr = (BitT \ 2048)
  105.         mm = (BitT - (hr * 2048)) \ 32
  106.         hr = ahr + hr
  107.         FTime$ = RIGHT$("00" + LTRIM$(STR$(hr)), 2) + ":" + RIGHT$("00"+ LTRIM$(STR$(mm)), 2)
  108.  
  109.         BitD = Buffer.AccessDate
  110.         yr = BitD \ 512
  111.         mo = (BitD - (yr * 512)) \ 32
  112.         da = BitD - (yr * 512) - (mo * 32)
  113.         FDate$ = RIGHT$("0" + LTRIM$(STR$(mo)), 2) + "-" + RIGHT$("0" +LTRIM$(STR$(da)), 2) + "-" + LTRIM$(STR$(80 + yr))
  114.  
  115.         x = INSTR(Buffer.FileName, ".")
  116.         IF x = 0 THEN
  117.                 FileTemp$ = LEFT$(Buffer.FileName + STRING$(12, 32), 12)
  118.         ELSE
  119.                 FileTemp$ = LEFT$(LEFT$(Buffer.FileName, x - 1) +SPACE$(12), 8) + MID$(Buffer.FileName, x, 4)
  120.         END IF
  121.  
  122.         IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
  123.                 FileTemp$ = MID$(Buffer.FileName, 1, 12)
  124.         END IF
  125.  
  126.         DirNum = DirNum + 1
  127.         Dir$(DirNum) = FileTemp$ + FSize$ + "  " + FDate$ + "  " +FTime$
  128.  
  129.         IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
  130.                 MID$(Dir$(DirNum), 13, 9) = "<dir>    "
  131.         END IF
  132.  
  133.         Buffer.Attributes = 0
  134.         Buffer.AccessTime = 0
  135.         Buffer.AccessDate = 0
  136.         Buffer.FileSize = 0
  137.         Buffer.FileName = STRING$(13, 32)
  138.         RETURN
  139. END SUB
  140.